MacHack 1994/MacHack 1994.toast/MacHack™ 1987-1994/MacHack™ '90/Source Code ƒ.sea/Source Code ƒ/Modula2 ƒ/DataStack Filer/DemoTest.MOD.o

Text File | 1990-06-15 | 5.8 KB | 222 lines | [OBJ /MPS ]

dCount := dataStkR.idCount;

        IF NOT LoadKeyArrays(idKeys,nameKeys,totalFilled,fRefNum) THEN
            DisposeDataStack(dataStk);
            RETURN NIL;
            END;

    (* load body *)
        count := VAL(LONGINT,cardSize * filledCards);
        dataStackErr := FSRead(fRefNum,count,dataPtr);
        END;(*with*)
    IF dataStackErr # 0 THEN
        DisposeDataStack(dataStk);
        RETURN NIL;
        END;(*with*)

    RETURN dataStk;
    END LoadDataStack;


PROCEDURE WriteGrowStacks(gStk :GrowStack; cardSize:CARDINAL; fRefNum:INTEGER);
VAR count :LONGINT;
BEGIN
    IF gStk = NIL THEN RETURN; END;

    WITH gStk^^ DO
        count := VAL(LONGINT,filledCards * cardSize);
        dataStackErr := FSWrite(fRefNum,count,dataPtr);
        IF dataStackErr # 0 THEN RETURN; END;
        END;

    WriteGrowStacks(gStk^^.growStk,cardSize,fRefNum);
    END WriteGrowStacks;

PROCEDURE DumpDataStack(stack:DataStack; fRefNum:INTEGER):BOOLEAN;
VAR
    err :OSErr;
    dataStkR :DataStackRec;
    count,count2 :LONGINT;
BEGIN
    dataStackErr := noErr;
    (* verify disk space *)
    WITH stack^^ DO
        IF totalFilled < filledCards THEN RETURN FALSE; END;

        count := SIZE(DataStackRec) + ( VAL(LONGINT,cardSize) * VAL(LONGINT,totalFilled) );
        INC(count,VAL(LONGINT,totalFilled)*4); (* space for both keys arrays *)
        count2 := count;
        END;
    err := AllocContig(fRefNum,count);
    IF err # 0 THEN
        dataStackErr := Allocate(fRefNum,count2);
        IF dataStackErr # 0 THEN RETURN FALSE; END;
        END;
    dataStkR := stack^^; (* save copy of dataStackRecord. *)
    WITH dataStkR DO
        DEC(cardSize,headerSize); (* rebuild DataStack when restored with orig. size. *)
        filledCards := totalFilled; (* when restored, filled = total. *)
        IF initialCards < totalFilled THEN
            initialCards := totalFilled;
            END;
        END;(*with*)

    (* write header *)
    count := SIZE(DataStackRec);
    dataStackErr := FSWrite(fRefNum,count,ADR(dataStkR));
    IF dataStackErr # 0 THEN RETURN FALSE; END;

    (* write keys arrays *)
    WITH stack^^ DO
        count := VAL(LONGINT,totalFilled)*SIZE(CARDINAL) + SIZE(CARDINAL);
        count2 := count;
        dataStackErr := FSWrite(fRefNum,count,idKeys^);
        IF dataStackErr # 0 THEN RETURN FALSE; END;

        dataStackErr := FSWrite(fRefNum,count2,nameKeys^);
        IF dataStackErr # 0 THEN RETURN FALSE; END;
        END; (*with*)

    (* write stack *)
    WITH stack^^ DO
        count := VAL(LONGINT,filledCards * cardSize);
        dataStackErr := FSWrite(fRefNum,count,dataPtr);
        IF dataStackErr # 0 THEN RETURN FALSE; END;
        END;

    (* write grow stacks *)
    WriteGrowStacks(stack^^.growStk,stack^^.cardSize,fRefNum);
    IF dataStackErr # noErr THEN RETURN FALSE; END;

    RETURN TRUE;
    END DumpDataStack;


PROCEDURE DisposeDataStack(stack:DataStack);
VAR gs,tgs :GrowStack;
BEGIN
    DisposPtr(stack^^.dataPtr);
    DisposHandle(stack^^.idKeys);
    DisposHandle(stack^^.nameKeys);

    gs := stack^^.growStk;
    WHILE gs # NIL DO
        tgs := gs;
        DisposPtr(gs^^.dataPtr);
        gs := gs^^.growStk;
        DisposHandle(tgs);
        END;
    DisposHandle(stack);
    END DisposeDataStack;


(* *****************************   card routines   ******************************** *)

PROCEDURE FindGrowHeaderAddr(gStk:GrowStack; cardNum0,cSize:CARDINAL):HeadPtr;
BEGIN
    WITH gStk^^ DO
        IF cardNum0 >= filledCards THEN
            RETURN FindGrowHeaderAddr(growStk,cardNum0-filledCards,cSize);
        ELSE
            RETURN VAL(ADDRESS, VAL(LONGCARD,cSize) * VAL(LONGCARD,cardNum0)) +
                        VAL(ADDRESS, dataPtr);
            END;
        END;
    END FindGrowHeaderAddr;

PROCEDURE GetHeaderAddr(stack:DataStack; cardNum:CARDINAL):HeadPtr;
BEGIN
    IF stack = NIL THEN RETURN NIL END;
    IF (cardNum < 1) OR (cardNum > stack^^.totalFilled) THEN RETURN NIL; END;
    DEC(cardNum); (* gives 0 based indexing to cardHeader *)
    WITH stack^^ DO
        IF cardNum >= filledCards THEN
            RETURN FindGrowHeaderAddr(growStk,cardNum-filledCards,cardSize);
        ELSE
            RETURN VAL( ADDRESS,VAL(LONGCARD,cardNum) * VAL(LONGCARD,cardSize) )
                             + VAL(ADDRESS, dataPtr);
            END;
        END;
    END GetHeaderAddr;


    (* **************************   search routines   ***************************** *)

    VAR
        theKeyIndex :CARDINAL;    (* index of last compare before return/failure *)

        theSearchID :LONGCARD;
        theSearchName :StringPtr;
        theStack :DataStack; (* stack to be searched *)

    PROCEDURE SearchStackByName(min,max :CARDINAL):CARDINAL;
    VAR
        strPtr :StringPtr;
        n :INTEGER;
    BEGIN
        IF max < min THEN RETURN 0; END;
        theKeyIndex := (min+max) DIV 2;

        strPtr := VAL(StringPtr,GetHeaderAddr(theStack,theStack^^.nameKeys^^[theKeyIndex]));
        n := IUCompString(theSearchName,strPtr);

        IF n = 0 THEN                                    (* theSearchX matches (indx)^. *)
            RETURN theKeyIndex;
        ELSIF n < 0 THEN                                (* theSearchX preceeds (indx)^. *)
            RETURN SearchStackByName(min,theKeyIndex-1);
        ELSE                                                (* theSearchX follows (indx)^. *)
            RETURN SearchStackByName(theKeyIndex+1,max);
            END;
        END SearchStackByName;

    PROCEDURE SearchStackByID(min,max :CARDINAL):CARDINAL;
    VAR
        header :HeadPtr;
        strPtr :StringPtr;
        n :INTEGER;
    BEGIN
        IF max < min THEN RETURN 0; END;
        theKeyIndex := (min+max) DIV 2;

        header := GetHeaderAddr(theStack,theStack^^.idKeys^^[theKeyIndex]);

        IF theSearchID = header^.id THEN
            RETURN theKeyIndex;
        ELSIF theSearchID < header^.id THEN
            RETURN SearchStackByID(min,theKeyIndex-1);
        ELSE
            RETURN SearchStackByID(theKeyIndex+1,max);
            END;
        END SearchStackByID;



PROCEDURE NewGrowStack(stack:DataStack):GrowStack;
VAR
    gStk :GrowStack;
    dPtr :Ptr;
    gCards :CARDINAL;
    iKeys,nKeys :DataKeysHnd;
    keyArrSize,gCardKeyGrow :LONGINT;
BEGIN
    WITH stack^^ DO
        iKeys := idKeys;
        nKeys := nameKeys;
        gCardKeyGrow := VAL(LONGINT,growCards)*SIZE(CARDINAL);

        dPtr := NewPtr(VAL(LONGINT,cardSize) * VAL(LONGINT,growCards));
        IF dPtr = NIL THEN
            dataStackErr := MemError();
            RETURN NIL;
            END;
        END;

    keyArrSize := GetHandleSize(iKeys);
    SetHandleSize(iKeys,keyArrSize + gCardKeyGrow);
    IF MemError() # 0 THEN
        dataStackErr := MemError();
        DisposPtr(dPtr);
        RETURN NIL;
        END;
    SetHandleSize(nKeys,keyArrSize + gCardKeyGrow);
    IF MemEr